BBS in a Box 4/BBS in a Box - Macintosh - Volume IV (January 1992) (BBS in a Box).iso/Files/Prog/S/STACKWND.PAS

Pascal/Delphi Source File | 1987-05-27 | 24.3 KB | 741 lines | [TEXT/MACA]

Program StackWindows;
{
   Mike asked my to add a few comments to his "MyWindow" example.  Well, I
   thought MyWindow was already pretty good but I started messing around
   anyway and this is what happened.  To those who may think that a lot of
   this looks like it was stolen right out of MiniEdit I can only say,
   "Right On".  I've even got bits of FORTH that look like MiniEdit.

   There is one departure from the user interface guidelines. Can you find
   it?  Can you fix it?
}

{$R-}    { Turn off range checking               }
{$I-}    { Turn off I/O error checking           }
{$B+}    { Turn on bundle bit }
{$R StackWindow.Rsrc}
{$T APPLSTAK}
{$U-}

uses PasInOut,Memtypes,QuickDraw,OSIntf,ToolIntf,PackIntf;

const
   AppleID     =  1000;    { IDs for our menus }
   FileID      =  1001;
   EditID      =  1002;
   WindowID    =  1003;
   Close       = 1;        { menu items }
   Quit        = 3;
   Undo        = 1;
   Cut         = 3;
   Copy        = 4;
   Paste       = 5;
   Clear       = 6;
   Make        = 1;
   Zap         = 2;
{  I'm being lazy. I should make these next ones variables and get them from
   WindowManagerPort.PortRect for large screens. }
   ScreenWidth    = 512;
   MenuBarHeight  = 20;
   ScreenHeight   = 342;
   Margin         = 4;
   MinWidth       = 40;
   MinHeight      = 40;
   SBarWidth      = 16;

var
   QuitIt            : boolean;
   ToRight, ToBottom : integer;
   theVBar,theHBar   : ControlHandle;
   NextWindowNumber  : LongInt;


{ **************************************************************************** }
PROCEDURE AutoScroll (theControl : ControlHandle; thePart: integer);
{
   Turbo loves to make static links but the ROM doesn't know squat about them.
   By putting this procedure out here we can force Turbo to make a dynamic link.
   AutoScroll gets called by TrackControl as long as the user is pressing the mouse
   ion someplace other tham the thumb of a scroll bar.
}
var
   delta    : integer;

begin { AutoScroll }
   case thePart of
      InUpButton     : delta  := -1;
      InDownButton   : delta  := 1;
      InPageUp       : delta  := -10;
      InPageDown     : delta  := 10
   end;  { case }
   if thePart <> 0 then SetCtlValue(theControl,GetCtlValue(theControl) + delta)
end;  { of AutoScroll }


{ **************************************************************************** }
PROCEDURE InitMac;
{
   InitMac is designed to be a standard initialization procedure that
   can be used in any application.
}
begin    { InitMac }
   InitGraf (@ThePort);
   InitFonts;
   InitWindows;
   InitMenus;
   TEInit;
   InitDialogs (Nil);   { If we were really doing a good job here we would
                          pass the address of of recovery routine, rather than
                          Nil, to InitDialogs.  Then, in case of a bomb, the
                          resume button would run our recovery routine. }

{ This next section isn't really necessary unless you're going to push
  the limits of available memory. Nonetheless, I recommend that you use it
  because it will keep your memory neat and may make your application run faster.
  Besides if some hacker Nosys your application and sees that you know about
  MoreMasters he or she will be impressed as hell. }

   MaxApplZone;
   MoreMasters;
   MoreMasters;
   MoreMasters;
   MoreMasters;

   InitCursor                    { Get a visible arrow cursor }
end;  { of InitMac }

{  There is a little story I want to tell on myself here. When I first got
   Mac Revealed I read Chernicoff's recommendation to use SetEventMask to
   keep events that weren't of interest to the application out of the event
   queue. Chernicoff had a nice little explanation about how the event queue
   only had room for 20 events ect. ect.  Well it sounded pretty convincing
   to me so I started putting SetEventMask calls in everything I wrote. For
   the next couple of days I started having all kinds of wierd trouble
   with my Mac. Not so much crashes as wierd behavior from programs that
   had always worked. Finally I looked up SetEventMask in IM and found that
   there were several caveats about using it.  It seems that SetEventMask
   is PERMANENT ie, it's effects last untill the you restart. There are
   several morals to this story:
   (1) Don't use SetEventMask.
   (2) If you must violate rule 1, put the system event mask back the
       way you found it before exiting and before letting any DAs run.
   (3) Don't believe everything you hear about Mac programming. }


{ **************************************************************************** }
PROCEDURE SetUpMenus;
{
   Another generic procedure.  If you can make an MBAR resource with ResEdit
   then this is the only code you will ever need to set up your menu bar.
   ( If your app has a font menu, then do an AddResMenu to that menu also
     to add the fonts )
}
const
   theMBar     =  1001;

var
   MBarHandle     : handle;
   AppleMenu      : MenuHandle;
   TheError       : integer;

begin    { SetUpMenus }
   MBarHandle  := GetNewMBar (theMBar);   { Gets a whole menu bar at once. }
   SetMenuBar (MBarHandle);               { Make it the current menu bar. }
   AppleMenu := GetMenu (AppleID);        { Get the Apple menu }
   InsertMenu (AppleMenu,FileID);         { Stick it in front of File Menu }
   AddResMenu (AppleMenu,'DRVR');         { Shove in DA's }
   DrawMenuBar                            { show user our pretty menu }
end;  { of SetUpMenus }


{ **************************************************************************** }
PROCEDURE ReadEvents;
{
   This is what they call the main event loop.  It is the heart of a
   Maclike program because it lets the user have control.
}
type
   ScrollHandle   =  ^ScrollPtr;
   ScrollPtr      =  ^ScrollRec;
   ScrollRec      =  Record
                     VBar, HBar  : ControlHandle
                     end;
{
   Take a look at the ScrollHandle structure above.  We're going to stick one into
   the WindowRefCon field of each window we make.  Since it only holds a couple of
   scroll bar handles, this may seem like overkill.  The point is that we can make
   the record that it refers to as elaborate as we want.  We could put text edit
   records, icons or whatever in the record.  This is a good place to store any
   data that we want to associate with the window.  ControlRefCons can be used in
   an analogous manner to associate whatever we want with a control.  BTW shouldn't
   Apple have called this field a WindowRefVar?
}
var
   theEvent       : EventRecord;


{ **************************************************************************** }
PROCEDURE MoveSBars (theWindow : WindowPtr);
{
   This little routine moves the scroll bars to where the're supposed to be
   when we open or resize a window.  Notice I overlap the scroll bar one pixel
   into the window frame.  This makes prettier scroll bars.
}
var
   therect  : rect;

begin { MoveSBars }
   HideControl (theVBar);
   HideControl (theHBar);
   with theWindow^.PortRect do
      begin
         MoveControl (theVBar, right - (SBarWidth - 1), -1);
         MoveControl (theHBar, -1, bottom - (SBarWidth - 1) );
         SizeControl (theVBar, SBarWidth, (bottom +1) - (top - 1) - (SBarWidth - 1));
         SizeControl (theHBar, (right + 1) - (left - 1) - (SBarWidth - 1), SBarWidth)
      end;  { with }
   ShowControl (theVBar);
   ShowControl (theHBar);
   ValidRect ( theHBar^^.contrlRect);  { We just drew these so don't let the }
   ValidRect (theVBar^^.contrlRect)    { Update event redraw them or we'll get flicker }
end;  { of MoveSBars }


{ **************************************************************************** }
PROCEDURE DoBye (TheWindow : WindowPtr);
{
   Here is the basic kill a window routine.  Note that DisposeWindow automagically
   kills the windows controls but the we made the ScrollHandle thingee so we have
   to do it in ourselves to keep memory neet.
}
var
   theHandle      : Handle;

begin { DoBye }
   if TheWindow <> FrontWindow then SelectWindow (TheWindow)
   else
      if TrackGoAway (TheWindow, TheEvent.where ) then
      begin
         DisposHandle (Handle(GetWRefCon(TheWindow)));
         DisposeWindow (TheWindow)
      end   { then }
end;  { of DoBye }


{ **************************************************************************** }
PROCEDURE DoChoice (theChoice : LongInt );   { We can get here either from a menu choice or
                                               from a command key alias. }
var
   theMenu, TheItem  : integer;


{ **************************************************************************** }
PROCEDURE DoApple;   { Handle the Apple menu }

const
   AboutItem   = 1;

var
   DA_Name     : Str255;
   DA_Number   : integer;
   AppleHandle  : MenuHandle;


{ **************************************************************************** }
PROCEDURE DoAbout;      { Put up our about box. }

const
   AboutDialog    = 1001;

var
   TheDlgPtr   : DialogPtr;
   DlgItem     : integer;

begin    { DoAbout }
   TheDlgPtr   := GetNewDialog (AboutDialog,Nil,WindowPtr(-1));
   ModalDialog (Nil,DlgItem);    { Put up our dialog }
   DisposDialog(TheDlgPtr)       { Clean up }
end;  { of DoAbout }

begin    { DoApple }
   if theItem = AboutItem then DoAbout else  { Either we do our about or it was a DA }
   begin
      AppleHandle := GetMHandle (AppleID);
      GetItem (AppleHandle, theItem, DA_Name);  { We have to find out the DAs name to get it open }
      DA_Number   := OpenDeskAcc (DA_Name);
   end;  { else }
end;  { of DoApple }


{ **************************************************************************** }
PROCEDURE DoFile;

var
   WhichDA     : WindowPeek;
   DA_Number   : integer;

begin
{
   The user can only chose close from the file menu when a DA is frontmost
   this routine figures out which DA was up and tells it to go bye-bye.  Of
   course we could have made close kill our own windows too but in this instance
   it seemed more logical to group the close and open command in their own menu.
}
   if theItem = Quit then QuitIt  := true
   else
   begin
      WhichDA     := WindowPeek(FrontWindow);
      DA_Number   := WhichDA^.windowKind;
      CloseDeskAcc (DA_Number)
   end;  { else }
end;  { of Dofile }


{ **************************************************************************** }
PROCEDURE DoEdit;
{
   We don't have anything to edit but it's nice to support miniWRITER.  Note
   that if you a standard edit menu then DA can be supported by just sending
   them the menu choice minus one.  If that doesn't work, it's the DA's fault.
   If your application also uses the edit menu, then just put your own code
   in after an "if not DA_Did then" phrase.  The OS will keep everything straight.
}
var
   DA_Did   : Boolean;

begin
   DA_Did   := SystemEdit (TheItem - 1)
end;  { of DoEdit }


{ **************************************************************************** }
PROCEDURE DoWindow;  { Handle a Window menu choice }

const
   MakeWindow     = 1;
   ZapWindow      = 2;


{ **************************************************************************** }
PROCEDURE DoMake; { Make a new window }

const
   WindowID    = 1001;

var
   TheWindow, FromWindow   : WindowPtr;
   theTitle, Count         : Str255;


{ **************************************************************************** }
PROCEDURE OffSet (WhichWindow, FromWindow : WindowPtr);
{
   Offset the window from the one under it.  GetNewWindow has a nasty habit of
   opening several identically sized windows right on top of each other so to the
   poor user can't see how many windows he has open.  This is my solution and, frankly,
   I'm a bit proud of it.
}
const
   theOffset   = 20;

var
   WindTopLeft : point;

begin { OffSet }
   WindTopLeft := FromWindow^.PortRect.TopLeft;
   LocalToGlobal (WindTopLeft);
   If WindTopLeft.h >= ScreenWidth - MinWidth then ToRight := -1;
   If WindTopLeft.h <= MinWidth then ToRight := 1;
   If WindTopLeft.v >= ScreenHeight - MinWidth then ToBottom := -1;
   If WindTopLeft.v <= MenuBarHeight + MinWidth then ToBottom := 1;
   MoveWindow (WhichWindow, WindTopLeft.h + theOffset * ToRight,
                            WindTopLeft.v + theOffset * ToBottom, false)
end;  { of OffSet }


{ **************************************************************************** }
FUNCTION DoScrolls (whichWindow : WindowPtr) : ScrollHandle;
{
   Returns a handle to a record containing two scroll bar handles.  Yeah, I know
   that doing all this just to keep track of scroll bar handles is a bit much.
   After all, the controlList field of the window record contains the handle to
   the first control in a linked list of all the window's controls.  I'm doing
   it this way here because you never know what kind of data structures you might
   want to associate with a window.  This routine is easy to generalize.
}
const
   ScrollID    = 1001;
var
   theHandle      : Handle;
   Scrolls        : ScrollHandle;

begin { DoScrolls }
   theHandle   := NewHandle( SizeOf (ScrollRec));
   HLock (theHandle);
   Scrolls  := ScrollHandle(theHandle);
   with Scrolls^^ do
   begin
      VBar  := GetNewControl(ScrollID, whichWindow);
      HBar  := GetNewControl(ScrollID, whichWindow);
      theVBar  := VBar;
      theHBar  := HBar
   end;  { with Scrolls }
   HUnLock (theHandle);
   DoScrolls   := Scrolls
end;  { of DoScrolls }

begin    { DoMake }
   FromWindow  := FrontWindow;
   TheWindow   := GetNewWindow (WindowID, Nil, WindowPtr(-1)); { Get a new window on the heap }
   NextWindowNumber  := NextWindowNumber + 1;
   If FromWindow <> Nil then OffSet (TheWindow, FromWindow);
   GetWTitle(TheWindow,theTitle);
   NumToString(NextWindowNumber,Count);
   theTitle := theTitle + Count;
   SetWTitle(TheWindow,theTitle);
   ShowWindow (TheWindow);
{  Next we get the scroll bars and store their handle in the window reference constant }
   SetWRefCon (TheWindow, LongInt(DoScrolls(TheWindow)));
   SetPort(TheWindow);
   MoveSBars(TheWindow)
end;  { of DoMake }


{ **************************************************************************** }
PROCEDURE DoZap;  { Close Front Window }

begin { DoZap }
   DisposHandle (Handle(GetWRefCon(FrontWindow)));
   DisposeWindow (FrontWindow)
end;  { of DoZap }

begin    { DoWindow }
   case theItem of
      MakeWindow  : DoMake;
      ZapWindow   : DoZap
   end;  { case }
end;  { of DoWindow }

begin { DoChoice }
   if theChoice <> 0 then
   begin
      theMenu  := HiWord (theChoice);
      TheItem  := LoWord (theChoice);
      case theMenu of
         AppleID  : DoApple;
         FileID   : DoFile;
         EditID   : DoEdit;
         WindowID : DoWindow
      end;  { case }
      HiliteMenu (0)    { UnHilite Menubar }
   end;   { if }
end;  { DoChoice }


{ **************************************************************************** }
PROCEDURE DoMouseDown;  { Handle MouseDowns }
{ There are many things that a mouse click can mean to a Mac aplication.
  Here we try to separate out all the important ones. }

var
   whichWindow    : WindowPtr;
   theClick       : integer;


{ **************************************************************************** }
PROCEDURE DoMenuClick;

var
   menuChoice     : LongInt;

begin    { DoMenuClick }
   menuChoice  := MenuSelect (TheEvent.where);  { find out what choice the user made }
   DoChoice ( menuChoice )
end;  { DoMenuClick }


{ **************************************************************************** }
PROCEDURE DoDrag (theWindow: WindowPtr);

var
   LimitRect   : rect;

begin { DoDrag }
   if theWindow = FrontWindow then
      begin
         SetRect (LimitRect, 0, MenuBarHeight, ScreenWidth, ScreenHeight);
         InSetRect (LimitRect, Margin, Margin); { Just make sure the user can't get
                                                  within 4 pixels of the edge }
         DragWindow (theWindow, TheEvent.where, LimitRect)
      end
   else
      SelectWindow(theWindow)
end;  { of DoDrag }


{ **************************************************************************** }
PROCEDURE DoGrow(theWindow: WindowPtr);

var
   sizerect       : rect;
   newSize        : LongInt;
   newWidth, newHeight  : integer;

begin { DoGrow }
   if theWindow <> FrontWindow then SelectWindow (theWindow )
   else
   begin
      SetRect (sizeRect,MinWidth,MinHeight,ScreenWidth,ScreenHeight - MenubarHeight);
      newSize  := GrowWindow (theWindow, TheEvent.Where, sizeRect);
      if newSize <> 0 then
      begin
         EraseRect (theWindow^.portRect);
         SizeWindow (theWindow, LoWord(NewSize), HiWord(NewSize), true );
         InvalRect (theWindow^.portRect); { We don't really need this. It's casmetic }
         MoveSBars (theWindow)
      end   { if newSize <> 0 }
   end   { else }
end;  { of DoGrow }


{ **************************************************************************** }
PROCEDURE DoContent (theWindow: WindowPtr);
{
   Content clicks can be in a control or just in the window.  We have to find
   out which
}
var
   thePoint    : point;
   thePart     : integer;
   theControl  : ControlHandle;


{ **************************************************************************** }
PROCEDURE DoBar (theControl : ControlHandle; thePart : integer);
{
   Note: You have to handle thumb clicks differently than every other kind!
}
begin   { DoBar }
   if thePart = InThumb then thePart   := TrackControl(theControl, thePoint, Nil)
   else
   thePart   := TrackControl(theControl, thePoint, @AutoScroll)
end;    { of DoBar }


{ **************************************************************************** }
PROCEDURE DoStampIcon(thePoint : point);
{
   Compile this and see this one for yourself.
}
const
   FaceIcon    = 1001;

var
   theIcon     : Handle;
   PlotRect    : rect;

begin { DoStampIcon }
   theIcon  := GetIcon(FaceIcon);
   SetRect(PlotRect, thePoint.h - 15, thePoint.v - 15, thePoint.h +16, thePoint.v + 16);
   PlotIcon(PlotRect,theIcon)
end;  { of DoStampIcon }

begin { DoContent }
   If theWindow <> FrontWindow then
      SelectWindow (theWindow)
   else
      begin
         thePoint := TheEvent.where;
         GlobalToLocal(thePoint);
         thePart  := FindControl (thePoint, theWindow, theControl);
         if theControl <> Nil then
            DoBar (theControl, thePart)
         else DoStampIcon(thePoint);
      end   { else }
end;  { of DoContent }


{ **************************************************************************** }
PROCEDURE DoZoom (TheWindow : WindowPtr; TheClick: integer);
{
   Zoom Windows!  Hope you have the new ROM.  With the 64K ROM this code
   never gets called.
}
begin { DoZoom }
   if TrackBox (TheWindow, TheEvent.where, TheClick) then
   begin
      EraseRect(TheWindow^.PortRect);
      ZoomWindow (TheWindow, TheClick, true);
      MoveSBars(TheWindow)
   end   { if }
end;  { of DoZoom }

begin { DoMouseDown }
   theClick := FindWindow (TheEvent.where,WhichWindow);
   case theClick of
      InMenuBar      : DoMenuClick;
      InSysWindow    : SystemClick(TheEvent, whichWindow);  { Pass the event on
                                                              to the DA }
      InDrag         : DoDrag (WhichWindow);
      InGrow         : DoGrow (WhichWindow);
      InGoAway       : DoBye (WhichWindow);
      InContent      : DoContent(WhichWindow);
      InZoomIn, InZoomOut  :  DoZoom (WhichWindow,theClick)
   end;  { case }
end;  { of DoMouseDown }


{ **************************************************************************** }
PROCEDURE DoKeyDown;    { Our KeyDown routine only checks for menu aliases }
{
   What can I say about this one?  If Bill Atkinson had written the Event Manager
   I'm sure we could do something nice and Pascalish.  But it needed to fit in 64K
   so they gave the job to Andy and he wrote it in assembler.  When you try to do
   down and dirty assembler type things from Pascal, the Pascal can get wierd.
   Let me just say that this code checks the event record to see if the command key
   was down.  If it wasn't the code does nothing. If it was, the code looks at
   the event record again to find out what other key was also down, calls the menu
   manager to see what that key is an alias for and then calls DoChoice as if the
   user had actually made a menu selection.  Quite a bit for one line!
}
begin { DoKeyDown }
   if (BitAnd (TheEvent.modifiers, CmdKey) <> 0) then   { Do nothing if command key wasn't down. }
      DoChoice (MenuKey(CHR(BitAnd(TheEvent.message,CharCodeMask))));
end;  { of DoKeyDown }


{ **************************************************************************** }
PROCEDURE DoUpdate;
{
   Take care of Update Events.  Another generic routine.
}

var
   SavePort    : GrafPtr;
   theWindow   : WindowPtr;

begin { DoUpdate }
   GetPort (SavePort);
   theWindow   := WindowPtr (TheEvent.message);
   SetPort (theWindow);
   BeginUpDate (theWindow);
      DrawGrowIcon(theWindow);
      DrawControls (theWindow);
   EndUpDate (theWindow);
   SetPort (SavePort)
end;  { of DoUpdate }


{ **************************************************************************** }
PROCEDURE DoActivate;
{
   Note how we set the global variables theVBar & theHBar.  The rest of this
   program can just use the globals and know that they refer to the controls
   for the right window.
}
const
   active      = 0;
   inactive    = 255;
var
   theWindow   : WindowPtr;
   theBars     : ScrollHandle;
   theHandle   : handle;

begin { DoActivate }
   theWindow   := WindowPtr(theEvent.message);
   SetPort (theWindow);
   thehandle   := handle(GetWRefCon(theWindow));
   HLock(thehandle);
   theBars  := ScrollHandle (thehandle);
   theVBar  := theBars^^.VBar;
   theHBar  := theBars^^.HBar;
   HUnLock(theHandle);
   if BitAnd (TheEvent.modifiers, ActiveFlag) <> 0
   then
      begin
         HiliteControl (theVBar, active);
         HiliteControl (theHBar, active)
      end   { if }
   else
      begin
         HiliteControl (theVBar, inactive);
         HiliteControl (theHBar, inactive)
      end;  { else }
   DrawGrowIcon(theWindow)
end;  { of DoActivate }

begin    { ReadEvents }
   if GetNextEvent(EveryEvent,theEvent) then
   case theEvent.what of
      MouseDown         : DoMouseDown;
      KeyDown           : DoKeyDown;
      UpDateEvt         : DoUpdate;
      ActivateEvt       : DoActivate
   end   { case }    { the OS can handle such events as disk insertion without help }
end;  { of ReadEvents }


{ **************************************************************************** }
PROCEDURE CheckMenus;
{
   Turn on Edit & Close Menus for DA's.  A lot of people are always screwing around
   with their menus depending on the users choices.  I like to do all my menu
   didling in one routine and put that routine in the main event loop.
}
var
   FileHandle, EditHandle, AppleHandle, WindHandle  : MenuHandle;
   theFront    : WindowPeek;
   DAs        : boolean;

begin { CheckMenus }
   WindHandle  := GetMHandle (WindowID);
   FileHandle  := GetMHandle (FileID);
   EditHandle  := GetMHandle (EditID);
   AppleHandle := GetMHandle (AppleID);
   theFront    := WindowPeek (FrontWindow);
   DAs         := false;
   if (theFront <> Nil) then if (theFront^.Windowkind <> UserKind) then DAs := true;
   { ie. if there's a window and it's not ours it must be a DA's. }
   If DAs then
   begin
      EnableItem (FileHandle,Close);
      EnableItem (EditHandle,Cut);
      EnableItem (EditHandle,Copy);
      EnableItem (EditHandle,Paste);
      EnableItem (EditHandle,Clear);
      EnableItem (EditHandle,Undo)
   end   { if }
   else
   begin
      DisableItem (FileHandle,Close);  { but if it's ours, turn em off }
      DisableItem (EditHandle,Cut);
      DisableItem (EditHandle,Copy);
      DisableItem (EditHandle,Paste);
      DisableItem (EditHandle,Clear);
      DisableItem (EditHandle,Undo)
   end;  { else }
   if (theFront <> Nil) and not DAs then EnableItem (WindHandle,Zap )
   else DisableItem (WindHandle,Zap ); { ie only enable Zap if there is one
                                        of our windows to zap. }
   { This next call checks to see if there is a least eneough memory for
     one more window.  If there isn't, we disable the menu choice. }
   if (CompactMem (SizeOf (WindowRecord)) >= SizeOf (WindowRecord))
   then EnableItem (WindHandle, Make) else DisableItem (WindHandle, Make)
end;  { of CheckMenus }

{  Isn't it nice to have a nice clean main routine?  I can't understand
   why anyone would want to use more than what's below. }

begin { StackWindows }
   InitMac;
   QuitIt  := False;
   NextWindowNumber  := 0;
   SetUpMenus;
   ToRight  := 1;
   ToBottom := 1;
   repeat
      ReadEvents;
      SystemTask;    { Give the DA's a shot. }
      CheckMenus
   Until QuitIt = true
end.  { of StackWindows }